Amiga Collections: Nordlicht Spiele/Nordlicht Spiele 04-04 (19xx)(Nordlicht)(DE)(PD).zip/Nordlicht Spiele 04-04 (19xx)(Nordlicht)(DE)(PD).adf/Billard/BillardSound.mod

Text File | 1992-09-23 | 6KB | 215 lines

(**********************************************************************
  :Program.    BillardSound.mod
  :Contents.   Sounds for Billard
  :Author.     Stefan Salewski
  :Copyright.  Shareware
  :Language.   Modula-2
  :Translator. M2Amiga AMSoft V3.3d
  :History.    V1.0 1.Dec.1989
  :Address.    Stolper Weg 3, D-2160 Stade
**********************************************************************)

IMPLEMENTATION MODULE BillardSound;
  FROM MemSystem IMPORT NoCareAllocMem; (* Autor: Nicolas Benezan *)
  FROM Arts IMPORT Assert,TermProcedure;
  FROM Audio IMPORT IOAudioPtr,IOAudio,audioName,pervol;
  FROM Exec IMPORT DevicePtr,write,OpenDevice,CloseDevice,Byte,
                   MsgPortPtr,IOFlagSet;
  FROM ExecSupport IMPORT CreatePort,DeletePort,BeginIO,AbortIO;
  FROM SYSTEM IMPORT ADR,LONGSET,CAST,ADDRESS;
  FROM RandomNumber IMPORT RND;

  CONST
    BallCurveSize0=30;
    BallCurveSize1=30;
    BorderCurveSize=30;
    HoleCurveSize=10;

  VAR
    ballCurve0Ptr:POINTER TO ARRAY[0..BallCurveSize0-1] OF Byte;
    ballCurve1Ptr:POINTER TO ARRAY[0..BallCurveSize1-1] OF Byte;
    borderCurvePtr:POINTER TO ARRAY[0..BorderCurveSize-1] OF Byte;
    holeCurvePtr:POINTER TO ARRAY[0..HoleCurveSize-1] OF Byte;
    soundPortPtr:ARRAY[0..3] OF MsgPortPtr;
    devicePtr:DevicePtr;
    allocationMap:ARRAY[0..15] OF Byte;
    ioAudioPtr:ARRAY[0..3] OF IOAudioPtr;
    i:INTEGER;

  PROCEDURE OpenAudio():BOOLEAN;
    VAR
      i,j,k:INTEGER;
      unit:ADDRESS;
  BEGIN
    FOR i:=0 TO 3 DO
      soundPortPtr[i]:=CreatePort(ADR("BillardSoundPort"),0);
      Assert(soundPortPtr[i]#NIL,ADR("Can't create Port"));
      NoCareAllocMem(ioAudioPtr[i],SIZE(IOAudio),TRUE);
    END;
    ioAudioPtr[0]^.request.message.node.pri:=-40;
    ioAudioPtr[0]^.request.message.replyPort:=soundPortPtr[0];
    FOR i:=0 TO 15 DO
      allocationMap[i]:=15-i;
    END;
    ioAudioPtr[0]^.data:=ADR(allocationMap);
    ioAudioPtr[0]^.length:=SIZE(allocationMap);
    OpenDevice(ADR(audioName),0,ioAudioPtr[0],LONGSET{});
    IF (ioAudioPtr[0]^.request.error#0) THEN
      RETURN FALSE
    END;
    unit:=ioAudioPtr[0]^.request.unit;
    devicePtr:=ioAudioPtr[0]^.request.device;
    j:=0;
    k:=-1;
    FOR i:=0 TO 3 DO
      WITH ioAudioPtr[i]^ DO
        request.message.replyPort:=soundPortPtr[i];
        request.device:=devicePtr;
        WHILE (j<4) AND NOT(j IN CAST(LONGSET,unit)) DO
          INC(j);
        END;
        IF j<4 THEN
          k:=j;
          request.unit:=CAST(ADDRESS,LONGSET{j});
        ELSIF k>=0 THEN
          request.unit:=CAST(ADDRESS,LONGSET{k});
        ELSE
          request.unit:=NIL; (* LONGSET{} *)
        END;
        INC(j);
        request.command:=write;
        request.flags:=pervol;
        allocKey:=ioAudioPtr[0]^.allocKey;
        period:=0;
        cycles:=0;
        volume:=0;
        data:=NIL;
        length:=0;
      END;
    END;
    RETURN TRUE;
  END OpenAudio;

  PROCEDURE InitSounds;
    VAR
      i:INTEGER;
  BEGIN
    NoCareAllocMem(ballCurve0Ptr,BallCurveSize0,TRUE);
    FOR i:=0 TO BallCurveSize0-1 DO
      IF ODD(i) THEN
        ballCurve0Ptr^[BallCurveSize0-1-i]:=i;
      ELSE
        ballCurve0Ptr^[BallCurveSize0-1-i]:=-i;
      END
    END;
    WITH ballSound0Ptr^ DO
      data:=ballCurve0Ptr;
      length:=SIZE(ballCurve0Ptr^);
      period:=2000;
      cycles:=1;
      volume:=64;
    END;

    NoCareAllocMem(borderCurvePtr,BorderCurveSize,TRUE);
    FOR i:=0 TO BorderCurveSize-1 DO
      IF ODD(i) THEN
        borderCurvePtr^[BorderCurveSize-1-i]:=i*RND(127 DIV BorderCurveSize)
      ELSE
        borderCurvePtr^[BorderCurveSize-1-i]:=-i*RND(127 DIV BorderCurveSize)
      END
    END;
    WITH borderSoundPtr^ DO
      data:=borderCurvePtr;
      length:=SIZE(borderCurvePtr^);
      period:=2000;
      cycles:=1;
      volume:=64;
    END;

    NoCareAllocMem(holeCurvePtr,HoleCurveSize,TRUE);
    FOR i:=0 TO HoleCurveSize-1 DO
      IF ODD(i) THEN
        holeCurvePtr^[HoleCurveSize-1-i]:=i*RND(127 DIV HoleCurveSize);
      ELSE
        holeCurvePtr^[HoleCurveSize-1-i]:=-i*RND(127 DIV HoleCurveSize);
      END
    END;
    WITH holeSoundPtr^ DO
      data:=holeCurvePtr;
      length:=SIZE(holeCurvePtr^);
      period:=24000;
      cycles:=1;
      volume:=64;
    END;

    NoCareAllocMem(ballCurve1Ptr,BallCurveSize1,TRUE);
    FOR i:=0 TO BallCurveSize1-1 DO
      IF ODD(i) THEN
        ballCurve1Ptr^[BallCurveSize1-1-i]:=i;
      ELSE
        ballCurve1Ptr^[BallCurveSize1-1-i]:=-i;
      END
    END;
    WITH ballSound1Ptr^ DO
      data:=ballCurve1Ptr;
      length:=SIZE(ballCurve1Ptr^);
      period:=2000;
      cycles:=1;
      volume:=64;
    END;
  END InitSounds;

  PROCEDURE Beep(soundPtr:IOAudioPtr;v:Volume);
  BEGIN
    IF soundPtr#NIL THEN
      soundPtr^.volume:=v;
      AbortIO(soundPtr);
      BeginIO(soundPtr);
    END
  END Beep;

  PROCEDURE CleanUp();
    VAR i:INTEGER;
  BEGIN
    (*IF CurrentLevel()<=startLevel THEN*)
    IF devicePtr#NIL THEN
       CloseDevice(ioAudioPtr[0]);
      devicePtr:=NIL;
    END;
    FOR i:=0 TO 3 DO
      IF soundPortPtr[i]#NIL THEN
        DeletePort(soundPortPtr[i]);
        soundPortPtr[i]:=NIL;
      END;
    END;
  END CleanUp;

BEGIN
  (*startLevel:=CurrentLevel();*)
  devicePtr:=NIL;
  FOR i:=0 TO 3 DO
    soundPortPtr[i]:=NIL;
    ioAudioPtr[i]:=NIL
  END;
  ballSound0Ptr :=NIL;
  ballSound1Ptr :=NIL;
  borderSoundPtr:=NIL;
  holeSoundPtr  :=NIL;
  TermProcedure(CleanUp);
  IF OpenAudio() THEN
    ballSound0Ptr :=ioAudioPtr[0];
    ballSound1Ptr :=ioAudioPtr[1];
    borderSoundPtr:=ioAudioPtr[2];
    holeSoundPtr  :=ioAudioPtr[3];
    InitSounds;
  END;
(*
  Attention: If any error occurs, then some soundPtr can be NIL.
  There is no warning, because we can play Billard without Sound.
  You can allways use Beep(soundPtr), but don't use BeginIO and AbortIO
  with a soundPtr=NIL.
*)
END BillardSound.